Data Source: https://www.mrlc.gov/data?f%5B0%5D=category%3ATree%20Canopy&f%5B1%5D=region%3Aconus
Data description: https://www.mrlc.gov/sites/default/files/TCC_Project_Overview_Brochure-MRLC_2020-06-05.pdf
About the source [Multi-Resolution Land Characteristics (MRLC) consortium]: https://www.mrlc.gov/about
Tree canopy cover (TCC) is the layer of tree leaves, needles, branches, and stems that provide tree coverage of the ground, viewed from an aerial perspective. The TCC maps represent canopy cover values, ranging from 0 to 100, for a 30 meter cell.
Automated classification techniques were used to produce tree canopy cover estimates. Forest Inventory and Analysis (FIA) plots were photo-interpreted for tree canopy cover using high resolution imagery and used to generate over 65,000 reference sites. Approximately 9,000 individual Landsat scenes, their spectral derivatives, harmonic regression coe cients, topographic data, and the reference sites were used as input data in the modeling procedure.
The data was retrieved using the FedData library, get_nlcd function. The function returns a RasterLayer of the three categories of NLCD data (tree canopy, impervious surfaces, landcover) cropped to a given template study area. In this project, we pulled the tree canopy data on tract, block and blockgroup levels for the designated locations around Virginia.
library(tidyverse)
library(leaflet)
library(sp)
library(viridis)
library(raster)
library(knitr)
library(dplyr)
library(kableExtra)
cville_tracts <- readRDS("Cville_Tree/cville_tracts.RDS")
cville_blkgps <- readRDS("Cville_Tree/cville_blkgps.RDS")
cville_blocks <- readRDS("Cville_Tree/cville_blocks.RDS")
cvillefips <- c("540", "3", "65", "79", "109", "125")
ggplot(cvl_tracts, aes(x=COUNTYFP, y=tree_can)) +
geom_point(shape=1) +
geom_density_2d_filled(size = 0.25, alpha = 0.5)+
scale_x_discrete(cvl_tracts$COUNTYFP, name ="COUNTYFP", labels= c("1" = "3", "2" ="65", "3" ="79", "4"="109", "5"="125", "6"="540"), breaks=c(1, 2, 3, 4, 5, 6))
kable(head(cvl_tracts))%>%
kable_styling(font_size = 12)
| STATEFP | COUNTYFP | TRACTCE | GEOID | NAMELSAD | tree_can | |
|---|---|---|---|---|---|---|
| 19 | 51 | 6 | 201 | 5.154e+10 | Census Tract 2.01 | 32.76820 |
| 41 | 51 | 6 | 202 | 5.154e+10 | Census Tract 2.02 | 11.58013 |
| 42 | 51 | 6 | 302 | 5.154e+10 | Census Tract 3.02 | 25.91021 |
| 43 | 51 | 6 | 401 | 5.154e+10 | Census Tract 4.01 | 34.10494 |
| 45 | 51 | 6 | 402 | 5.154e+10 | Census Tract 4.02 | 22.95314 |
| 44 | 51 | 6 | 501 | 5.154e+10 | Census Tract 5.01 | 34.68436 |
ggplot(cvl_tracts) +
geom_col(aes(x=as.factor(GEOID), y=tree_can)) +
coord_flip() +
labs(x="GEOID",
y="% Tree Canopy",
title="% Tree Canopy by GEOID")+
theme(axis.text.y = element_text(face="plain", color="black",
size=5))
cville_tracts$tree_can <- cvl_tracts$tree_can
pal <- colorNumeric("plasma", reverse = TRUE, domain = cvl_tracts$tree_can)
cvl_tracts$tree_can <- as.numeric(cvl_tracts$tree_can)
cville_tracts$COUNTYFP <- as.numeric(cville_tracts$COUNTYFP)
m <- leaflet()%>%
addTiles()%>%
addPolygons(data = cville_tracts,
fillColor = ~pal(tree_can),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(weight = 2, fillOpacity = 0.8, bringToFront = T),
popup = paste0("FIPS Code: ", cvl_tracts$GEOID, "<br>",
"Tree Canopy: ", cvl_tracts$tree_can,"<br>",
"Tract: ", cvl_tracts$NAMELSAD)) %>%
addLegend("bottomright", pal = pal, values = cvl_tracts$tree_can,
title = "Tree Canopy", opacity = 0.7)
m
cvl_blkgps <- read.csv("Cville_Tree/nlcd_tree_cville_blkgps.csv")%>%
as.data.frame()
cvl_blkgps <- cvl_blkgps[order(cvl_blkgps$TRACTCE), ]
kable(head(cvl_blkgps))%>%
kable_styling(font_size = 12)
| STATEFP | COUNTYFP | TRACTCE | BLKGRPCE | GEOID | NAMELSAD | tree_can | |
|---|---|---|---|---|---|---|---|
| 54 | 51 | 540 | 201 | 3 | 5.154e+11 | Block Group 3 | 39.102459 |
| 55 | 51 | 540 | 201 | 1 | 5.154e+11 | Block Group 1 | 43.246032 |
| 89 | 51 | 540 | 201 | 2 | 5.154e+11 | Block Group 2 | 15.508475 |
| 6 | 51 | 540 | 202 | 2 | 5.154e+11 | Block Group 2 | 9.651163 |
| 92 | 51 | 540 | 202 | 3 | 5.154e+11 | Block Group 3 | 18.833333 |
| 108 | 51 | 540 | 202 | 1 | 5.154e+11 | Block Group 1 | 8.282908 |
cville_blkgps$tree_can <- cvl_blkgps$tree_can
pal <- colorNumeric("plasma", reverse = TRUE, domain = cvl_blkgps$tree_can)
cvl_blkgps$tree_can <- as.numeric(cvl_blkgps$tree_can)
cville_blkgps$COUNTYFP <- as.numeric(cville_blkgps$COUNTYFP)
m <- leaflet()%>%
addTiles()%>%
addPolygons(data = cville_blkgps,
fillColor = ~pal(tree_can),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(weight = 2, fillOpacity = 0.8, bringToFront = T),
popup = paste0("FIPS Code: ", cvl_blkgps$GEOID, "<br>",
"Tree Canopy: ", cvl_blkgps$tree_can,"<br>",
"Blockgroup: ", cvl_blkgps$NAMELSAD)) %>%
addLegend("bottomright", pal = pal, values = cvl_blkgps$tree_can,
title = "Tree Canopy", opacity = 0.7)
m
cvl_blocks <- read.csv("Cville_Tree/nlcd_tree_cville_blocks.csv")%>%
as.data.frame()
kable(head(cvl_blocks))%>%
kable_styling(font_size = 12)
| STATEFP10 | COUNTYFP10 | TRACTCE10 | BLOCKCE10 | GEOID10 | NAME10 | tree_can |
|---|---|---|---|---|---|---|
| 51 | 3 | 10401 | 3025 | 5.100301e+14 | Block 3025 | 74.666667 |
| 51 | 3 | 10401 | 3004 | 5.100301e+14 | Block 3004 | 0.000000 |
| 51 | 3 | 10401 | 3005 | 5.100301e+14 | Block 3005 | 25.907297 |
| 51 | 3 | 10401 | 3021 | 5.100301e+14 | Block 3021 | 46.275294 |
| 51 | 3 | 10401 | 3016 | 5.100301e+14 | Block 3016 | 44.680297 |
| 51 | 3 | 10401 | 3019 | 5.100301e+14 | Block 3019 | 7.082353 |
cville_blocks$tree_can <- cvl_blocks$tree_can
pal <- colorNumeric("plasma", reverse = TRUE, domain = cvl_blocks$tree_can)
cvl_blocks$tree_can <- as.numeric(cvl_blocks$tree_can)
cville_blocks$COUNTYFP <- as.numeric(cville_blocks$COUNTYFP)
m <- leaflet()%>%
addTiles()%>%
addPolygons(data = cville_blocks,
fillColor = ~pal(tree_can),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(weight = 2, fillOpacity = 0.8, bringToFront = T),
popup = paste0("FIPS Code: ", cvl_blocks$GEOID, "<br>",
"Tree Canopy: ", cvl_blocks$tree_can,"<br>",
"Block: ", cvl_blocks$NAME10)) %>%
addLegend("bottomright", pal = pal, values = cvl_blocks$tree_can,
title = "Tree Canopy", opacity = 0.7)
m